home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / vol16n12.zip / ICONED.ZIP / ICON_SRC.ZIP / MAIN.PAS < prev   
Pascal/Delphi Source File  |  1997-05-04  |  20KB  |  822 lines
  1. unit Main;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  7.   Dialogs, StdCtrls, ExtCtrls, ColorGrd, Buttons, Icon, Menus,
  8.   ShellApi, Clipbrd, IniFiles, About;
  9.  
  10. const
  11.   DefaultWidth = 383;
  12.   DefaultHeight = 388;
  13.  
  14. var
  15.   Imported : boolean;
  16.   
  17. type
  18.   TMainForm = class(TForm)
  19.     ToolPanel: TPanel;
  20.     MainMenu1: TMainMenu;
  21.     File1: TMenuItem;
  22.     Open1: TMenuItem;
  23.     OpenDialog1: TOpenDialog;
  24.     New1: TMenuItem;
  25.     Save: TMenuItem;
  26.     SaveAs: TMenuItem;
  27.     Exit1: TMenuItem;
  28.     SaveDialog1: TSaveDialog;
  29.     CaptureSpeedButton: TSpeedButton;
  30.     PencilSpeedButton: TSpeedButton;
  31.     TransparentPanel: TPanel;
  32.     ReversePanel: TPanel;
  33.     Panel0: TPanel;
  34.     Panel1: TPanel;
  35.     Panel2: TPanel;
  36.     Panel3: TPanel;
  37.     Panel4: TPanel;
  38.     Panel5: TPanel;
  39.     Panel6: TPanel;
  40.     Panel7: TPanel;
  41.     Panel8: TPanel;
  42.     Panel9: TPanel;
  43.     Panel10: TPanel;
  44.     Panel11: TPanel;
  45.     Panel12: TPanel;
  46.     Panel13: TPanel;
  47.     Panel14: TPanel;
  48.     Panel15: TPanel;
  49.     LeftButtonPanel: TPanel;
  50.     RightButtonPanel: TPanel;
  51.     Close1: TMenuItem;
  52.     CloseAll1: TMenuItem;
  53.     Edit1: TMenuItem;
  54.     Undo: TMenuItem;
  55.     N2: TMenuItem;
  56.     Cut: TMenuItem;
  57.     Copy: TMenuItem;
  58.     Paste: TMenuItem;
  59.     SelectAll: TMenuItem;
  60.     Help1: TMenuItem;
  61.     Topics: TMenuItem;
  62.     About1: TMenuItem;
  63.     Window1: TMenuItem;
  64.     Cascade1: TMenuItem;
  65.     Tile1: TMenuItem;
  66.     FillSpeedButton: TSpeedButton;
  67.     LineSpeedButton: TSpeedButton;
  68.     ClearRectangleSpeedButton: TSpeedButton;
  69.     FilledRectangleSpeedButton: TSpeedButton;
  70.     ClearEllipseSpeedButton: TSpeedButton;
  71.     FilledEllipseSpeedButton: TSpeedButton;
  72.     N3: TMenuItem;
  73.     ShowPixels: TMenuItem;
  74.     NewSpeedButton: TSpeedButton;
  75.     SaveSpeedButton: TSpeedButton;
  76.     TestIcon: TMenuItem;
  77.     Icon1: TMenuItem;
  78.     procedure ReadIni;
  79.     procedure WriteIni;
  80.     procedure SaveSpeedButtonClick(Sender: TObject);
  81.     function  ReadIconFromFile(OpenName, FileName,
  82.       IconName : string; ANewIcon : boolean) : boolean;
  83.     procedure Open1Click(Sender: TObject);
  84.     procedure Exit1Click(Sender: TObject);
  85.     procedure New1Click(Sender: TObject);
  86.     procedure SaveAsClick(Sender: TObject);
  87.     procedure FormCreate(Sender: TObject);
  88.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  89.     procedure Panel0MouseDown(Sender: TObject; Button: TMouseButton;
  90.       Shift: TShiftState; X, Y: Integer);
  91.     procedure TopicsClick(Sender: TObject);
  92.     procedure About1Click(Sender: TObject);
  93.     procedure Cascade1Click(Sender: TObject);
  94.     procedure Tile1Click(Sender: TObject);
  95.     procedure Close1Click(Sender: TObject);
  96.     procedure CloseAll1Click(Sender: TObject);
  97.     procedure CaptureSpeedButtonClick(Sender: TObject);
  98.     function  Read16BitIcons(P : pchar) : boolean;
  99.     procedure Import(FileName : TFileName);
  100.     procedure UpdateTool;
  101.     procedure UpdateButtons;
  102.     procedure File1Click(Sender: TObject);
  103.     procedure Edit1Click(Sender: TObject);
  104.     procedure UndoClick(Sender: TObject);
  105.     procedure CutClick(Sender: TObject);
  106.     procedure CopyClick(Sender: TObject);
  107.     procedure PasteClick(Sender: TObject);
  108.     procedure SelectAllClick(Sender: TObject);
  109.     procedure ShowPixelsClick(Sender: TObject);
  110.     procedure TestIconClick(Sender: TObject);
  111.     procedure FormResize(Sender: TObject);
  112.     procedure FormShow(Sender: TObject);
  113.   private
  114.     { Private declarations }
  115.     NewIconCnt : integer;
  116.   public
  117.     { Public declarations }
  118.     TempIconFile : string;
  119.     DrawingTool : TDrawingTools;
  120.     TestColorIndex : integer;
  121.   end;
  122.  
  123. var
  124.   MainForm: TMainForm;
  125.  
  126. implementation
  127.  
  128. {$R *.DFM}
  129.  
  130.  
  131. procedure TMainForm.ReadIni;
  132. begin
  133.   with TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) do
  134.   try
  135.     with MainForm do
  136.     begin
  137.       Width:= ReadInteger('Setup', 'Width', DefaultWidth);
  138.       Height:= ReadInteger('Setup', 'Height', DefaultHeight);
  139.       Top:= ReadInteger('Setup', 'Top',
  140.         (GetSystemMetrics(SM_CYSCREEN) - Height) div 2);
  141.       Left:= ReadInteger('Setup', 'Left',
  142.         (GetSystemMetrics(SM_CXSCREEN) - Width) div 2);
  143.     end;
  144.  
  145.     ShowPixels.Checked:= ReadBool('Setup', 'Show Pixels', true);
  146.     TestColorIndex:= ReadInteger('Setup', 'Test Color', 7);
  147.   finally
  148.     Free;
  149.   end;
  150. end;
  151.  
  152. procedure TMainForm.WriteIni;
  153. begin
  154.   with TIniFile.Create(ChangeFileExt(Application.ExeName, '.INI')) do
  155.   try
  156.     if WindowState <> wsMaximized then
  157.     with MainForm do
  158.     begin
  159.       WriteInteger('Setup', 'Width', Width);
  160.       WriteInteger('Setup', 'Height', Height);
  161.       WriteInteger('Setup', 'Top', Top);
  162.       WriteInteger('Setup', 'Left', Left);
  163.     end;
  164.  
  165.     WriteBool('Setup', 'Show Pixels', ShowPixels.Checked);
  166.     WriteInteger('Setup', 'Test Color', TestColorIndex);
  167.   finally
  168.     Free;
  169.   end;
  170. end;
  171.  
  172. procedure TMainForm.SaveSpeedButtonClick(Sender: TObject);
  173. begin
  174.   if MDIChildCount = 0 then exit;
  175.   with TIconForm(ActiveMDIChild) do
  176.   if NewIcon then
  177.     SaveAsClick(Sender)
  178.   else
  179.     SaveIcon(Sender);
  180. end;
  181.  
  182. function TMainForm.ReadIconFromFile(OpenName, FileName,
  183.   IconName : string; ANewIcon : boolean) : boolean;
  184. var
  185.   NumRead : longint;
  186.   i, ImageCount : integer;
  187.   PIndex : pchar;
  188. begin
  189.   Result:= false;
  190.   with TIconForm.Create(Application) do
  191.   try
  192.     IconFileName:= FileName;
  193.     Caption:= IconName;
  194.     NewIcon:= ANewIcon;
  195.  
  196.     IconSize:= 32;
  197.  
  198.     SetupWindow;
  199.  
  200.     {$I-}
  201.     AssignFile(F, OpenName);
  202.     FileMode:= 0;
  203.     Reset(F, 1);
  204.     {$I+}
  205.     if IOResult <> 0 then
  206.     begin
  207.       Free;
  208.       exit;
  209.     end;
  210.  
  211.     IconFileSize:= FileSize(F);
  212.  
  213.     GetMem(IconBuffer, IconFileSize);
  214.     if not assigned(IconBuffer) then
  215.     begin
  216.       Free;
  217.       exit;
  218.     end;
  219.  
  220.     PIndex:= @IconBuffer[0];
  221.     BlockRead(F, IconBuffer^, IconFileSize, NumRead);
  222.     if (NumRead <> IconFileSize) or
  223.        (NumRead < sizeof(TIconDir)) or
  224.        (PIconDir(PIndex).idReserved <> 0) or
  225.        (PIconDir(PIndex).idType <> 1) then
  226.     begin
  227.       Free;
  228.       exit;
  229.     end;
  230.  
  231.     ImageCount:= PIconDir(PIndex).idCount;
  232.     PIndex:= @IconBuffer[sizeof(TIconDir)];
  233.  
  234.     for i:= 0 to ImageCount - 1 do
  235.     begin
  236.       if NumRead < sizeof(TIconDir) + sizeof(TIconDirEntry) * i then
  237.       begin
  238.         Free;
  239.         exit;
  240.       end;
  241.  
  242.       if (PIconDirEntry(PIndex).bWidth = 32) and
  243.          (PIconDirEntry(PIndex).bHeight = 32) and
  244.          ((PIconDirEntry(PIndex).bColorCount = 16) or
  245.           (PIconDirEntry(PIndex).bColorCount = 4)) and
  246.          (PIconDirEntry(PIndex).bReserved = 0) then
  247.       begin
  248.         PIndex:= @IconBuffer[PIconDirEntry(PIndex).dwImageOffset];
  249.         ImageOffset:= PIndex;
  250.  
  251.         Move(PIconImage(PIndex).icColors,
  252.              IconColors,
  253.              16 * sizeof(TRGBQuad));
  254.  
  255.         SetupUndoBuff;
  256.  
  257.         Result:= true;
  258.         exit;
  259.       end;
  260.  
  261.       MessageDlg('32x32, 16 color icon not found',
  262.         mtError, [mbOK], 0);
  263.       Free;
  264.     end;
  265.   finally
  266.     CloseFile(F);
  267.   end;
  268. end;
  269.  
  270. procedure TMainForm.Open1Click(Sender: TObject);
  271. begin
  272.   with OpenDialog1 do
  273.   begin
  274.     FileName:= '';
  275.     if Execute then
  276.       if ExtractFileExt(FileName) <> 'ICO' then
  277.         Import(FileName)
  278.       else
  279.         ReadIconFromFile(FileName,
  280.                          FileName,
  281.                          ExtractFileName(FileName),
  282.                          false);
  283.   end;
  284.   UpdateButtons;
  285. end;
  286.  
  287. procedure TMainForm.Exit1Click(Sender: TObject);
  288. begin
  289.   Close;
  290. end;
  291.  
  292. procedure TMainForm.New1Click(Sender: TObject);
  293. var
  294.   PIndex : pchar;
  295. begin
  296.   with TIconForm.Create(Application) do
  297.   try
  298.     inc(NewIconCnt);
  299.     Caption:= 'Icon' + IntToStr(NewIconCnt) + '.ico';
  300.     IconFileName:= Caption;
  301.     NewIcon:= true;
  302.     IconSize:= 32;
  303.  
  304.     SetupWindow;
  305.  
  306.     IconFileSize:= sizeof(TIconDir) +
  307.                    sizeof(TIconDirEntry) +
  308.                    sizeof(TIconImage);
  309.  
  310.     GetMem(IconBuffer, IconFileSize);
  311.     if not assigned(IconBuffer) then
  312.     begin
  313.       Free;
  314.       exit;
  315.     end;
  316.  
  317.     PIndex:= @IconBuffer[0];
  318.     PIconDir(PIndex).idReserved:= 0;
  319.     PIconDir(PIndex).idType:= 1;
  320.     PIconDir(PIndex).idCount:= 1;
  321.  
  322.     PIndex:= @IconBuffer[sizeof(TIconDir)];
  323.     PIconDirEntry(PIndex).bWidth:= 32;
  324.     PIconDirEntry(PIndex).bHeight:= 32;
  325.     PIconDirEntry(PIndex).bColorCount:= 16;
  326.     PIconDirEntry(PIndex).bReserved:= 0;
  327.     PIconDirEntry(PIndex).wPlanes:= 0;
  328.     PIconDirEntry(PIndex).wBitCount:= 0;
  329.     PIconDirEntry(PIndex).dwBytesInRes:= sizeof(TIconImage);
  330.     PIconDirEntry(PIndex).dwImageOffset:= sizeof(TIconDir) +
  331.                                           sizeof(TIconDirEntry);
  332.  
  333.     PIndex:= @IconBuffer[PIconDirEntry(PIndex).dwImageOffset];
  334.     ImageOffset:= PIndex;
  335.  
  336.     FillChar(PIconImage(PIndex).icHeader,
  337.              sizeof(PIconImage(PIndex).icHeader),
  338.              0);
  339.     PIconImage(PIndex).icHeader.biSize:= sizeof(TBitMapInfoHeader);
  340.     PIconImage(PIndex).icHeader.biWidth:= 32;
  341.     PIconImage(PIndex).icHeader.biHeight:= 64;
  342.     PIconImage(PIndex).icHeader.biPlanes:= 1;
  343.     PIconImage(PIndex).icHeader.biBitCount:= 4;
  344.     PIconImage(PIndex).icHeader.bisizeimage:= 640;
  345.  
  346.     Move(DefaultColors,
  347.          PIconImage(PIndex).icColors,
  348.          16 * sizeof(TRGBQuad));
  349.  
  350.     Move(PIconImage(PIndex).icColors,
  351.                IconColors,
  352.                16 * sizeof(TRGBQuad));
  353.  
  354.     FillChar(PIconImage(PIndex).icXOR,
  355.              sizeof(TXorMask),
  356.              0);
  357.  
  358.     FillChar(PIconImage(PIndex).icAND,
  359.              sizeof(TAndMask),
  360.              $FF);
  361.  
  362.     SetupUndoBuff;
  363.  
  364.     UpdateButtons;
  365.   finally
  366.   end;
  367. end;
  368.  
  369. procedure TMainForm.SaveAsClick(Sender: TObject);
  370. begin
  371.   if MDIChildCount = 0 then exit;
  372.   with SaveDialog1, TIconForm(ActiveMDIChild) do
  373.   begin
  374.     Title:= 'Save ' + IconFileName + ' As';
  375.     FileName:= IconFileName;
  376.     if Execute then
  377.     begin
  378.       NewIcon:= false;
  379.       IconFileName:= FileName;
  380.       Caption:= ExtractFileName(FileName);
  381.       SaveSpeedButtonClick(Sender);
  382.     end;
  383.   end;
  384. end;
  385.  
  386. procedure TMainForm.FormCreate(Sender: TObject);
  387. begin
  388.   ReadIni;
  389.  
  390.   TempIconFile:= ExtractFileDir(Application.ExeName);
  391.   if TempIconFile[length(TempIconFile)] <> '\' then
  392.     TempIconFile:= TempIconFile + '\';
  393.   TempIconFile:= TempIconFile + 'Temp$$$$.ico';
  394.  
  395.   DrawingTool:= Pencil;
  396.   UpdateTool;
  397.  
  398.   UpdateButtons;
  399. end;
  400.  
  401. procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
  402. begin
  403.   WriteIni;
  404. end;
  405.  
  406. procedure TMainForm.Panel0MouseDown(Sender: TObject; Button: TMouseButton;
  407.   Shift: TShiftState; X, Y: Integer);
  408. begin
  409.   with Sender as TPanel do
  410.   case Button of
  411.   mbLeft:
  412.     begin
  413.       LeftButtonPanel.Color:= Color;
  414.       LeftButtonPanel.Tag:= Tag;
  415.       with LeftButtonPanel do
  416.       case Tag of
  417.         0 : Caption:= '';
  418.         1 : Caption:= 'T';
  419.         2 : Caption:= 'R';
  420.       end;
  421.     end;
  422.   mbRight:
  423.     begin
  424.       RightButtonPanel.Color:= Color;
  425.       RightButtonPanel.Tag:= Tag;
  426.       with RightButtonPanel do
  427.       case Tag of
  428.         0 : Caption:= '';
  429.         1 : Caption:= 'T';
  430.         2 : Caption:= 'R';
  431.       end;
  432.     end;
  433.   end;
  434. end;
  435.  
  436. procedure TMainForm.TopicsClick(Sender: TObject);
  437. begin
  438.   Application.HelpCommand(HELP_PARTIALKEY, 0);
  439. end;
  440.  
  441. procedure TMainForm.About1Click(Sender: TObject);
  442. begin
  443.   with TAboutBox.Create(Application) do
  444.   try
  445.     ShowModal;
  446.   finally
  447.     Free;
  448.   end;
  449. end;
  450.  
  451. procedure TMainForm.Cascade1Click(Sender: TObject);
  452. begin
  453.   Cascade;
  454. end;
  455.  
  456. procedure TMainForm.Tile1Click(Sender: TObject);
  457. begin
  458.   Tile;
  459. end;
  460.  
  461. procedure TMainForm.Close1Click(Sender: TObject);
  462. begin
  463.   if MDIChildCount = 0 then exit;
  464.   TIconForm(ActiveMDIChild).Close;
  465.   Application.ProcessMessages;
  466.   UpdateButtons;
  467. end;
  468.  
  469. procedure TMainForm.CloseAll1Click(Sender: TObject);
  470. var
  471.   i : integer;
  472. begin
  473.   if MDIChildCount = 0 then exit;
  474.   for i:= MDIChildCount - 1 downto 0 do
  475.   begin
  476.     if MDIChildCount - 1 <> i then break;
  477.     TIconForm(MDIChildren[i]).Close;
  478.     Application.ProcessMessages;
  479.   end;
  480.   UpdateButtons;
  481. end;
  482.  
  483. procedure TMainForm.CaptureSpeedButtonClick(Sender: TObject);
  484. begin
  485.   with Sender as TSpeedButton do
  486.     DrawingTool:= TDrawingTools(Tag);
  487.  
  488.   if MDIChildCount = 0 then exit;
  489.  
  490.   with TIconForm(ActiveMDIChild) do
  491.   begin
  492.     CapturedDraw;
  493.     IconTool:= DrawingTool;
  494.     UpdateCursor;
  495.   end;
  496. end;
  497.  
  498. function EnumResName(Module : THandle; ResourceType : pointer;
  499.   ResourceName : pchar; Param : longint) : boolean; StdCall;
  500. var
  501.   hGlobal : THandle;
  502.   lpIconDir, lpIconImage : pchar;
  503.   PIndex : pchar;
  504. begin
  505.   Result:= false;
  506.  
  507.   hGlobal:= LoadResource(
  508.             Module,
  509.             FindResource(
  510.             Module,
  511.             ResourceName,
  512.             ResourceType));
  513.   if hGlobal = 0 then
  514.   begin
  515.     ShowMessage('Load icon failed');
  516.     exit;
  517.   end;
  518.  
  519.   lpIconDir:= LockResource(hGlobal);
  520.   if lpIconDir = nil then
  521.   begin
  522.     ShowMessage('Lock icon in memory failed');
  523.     exit;
  524.   end;
  525.  
  526.   PIndex:= lpIconDir;
  527.  
  528.   Result:= true;
  529.  
  530.   if (PIconDir(PIndex).idReserved <> 0) or
  531.      (PIconDir(PIndex).idType <> 1) then
  532.     exit;
  533.  
  534.   PIndex:= @lpIconDir[sizeof(TIconDir)];
  535.  
  536.   if (PGrpIconDirEntry(PIndex).bWidth <> 32) or
  537.      (PGrpIconDirEntry(PIndex).bHeight <> 32) or
  538.      ((PGrpIconDirEntry(PIndex).bColorCount <> 16) and
  539.       (PGrpIconDirEntry(PIndex).bColorCount <> 4)) then
  540.     exit;
  541.  
  542.   Result:= false;
  543.  
  544.   hGlobal:= LoadResource(
  545.             Module,
  546.             FindResource(
  547.             Module,
  548.             MakeIntResource(PGrpIconDirEntry(PIndex).nID),
  549.             RT_ICON));
  550.   if hGlobal = 0 then
  551.   begin
  552.     ShowMessage('Load icon failed');
  553.     exit;
  554.   end;
  555.  
  556.   lpIconImage:= LockResource(hGlobal);
  557.   if lpIconImage = nil then
  558.   begin
  559.     ShowMessage('Lock icon in memory failed');
  560.     exit;
  561.   end;
  562.  
  563.   Result:= true;
  564.   Imported:= true;
  565.  
  566.   with TIconForm.Create(Application) do
  567.   try
  568.     inc(MainForm.NewIconCnt);
  569.     Caption:= 'Icon' + IntToStr(MainForm.NewIconCnt) + '.ico';
  570.     IconFileName:= Caption;
  571.     NewIcon:= true;
  572.     IconSize:= 32;
  573.  
  574.     SetupWindow;
  575.  
  576.     IconFileSize:= sizeof(TIconDir) +
  577.                    sizeof(TIconDirEntry) +
  578.                    sizeof(TIconImage);
  579.  
  580.     GetMem(IconBuffer, IconFileSize);
  581.     if not assigned(IconBuffer) then
  582.     begin
  583.       Free;
  584.       exit;
  585.     end;
  586.  
  587.     PIndex:= @IconBuffer[0];
  588.     PIconDir(PIndex).idReserved:= 0;
  589.     PIconDir(PIndex).idType:= 1;
  590.     PIconDir(PIndex).idCount:= 1;
  591.  
  592.     PIndex:= @IconBuffer[sizeof(TIconDir)];
  593.     PIconDirEntry(PIndex).bWidth:= 32;
  594.     PIconDirEntry(PIndex).bHeight:= 32;
  595.     PIconDirEntry(PIndex).bColorCount:= 16;
  596.     PIconDirEntry(PIndex).bReserved:= 0;
  597.     PIconDirEntry(PIndex).wPlanes:= 0;
  598.     PIconDirEntry(PIndex).wBitCount:= 0;
  599.     PIconDirEntry(PIndex).dwBytesInRes:= sizeof(TIconImage);
  600.     PIconDirEntry(PIndex).dwImageOffset:= sizeof(TIconDir) +
  601.                                           sizeof(TIconDirEntry);
  602.  
  603.     PIndex:= @IconBuffer[PIconDirEntry(PIndex).dwImageOffset];
  604.     ImageOffset:= PIndex;
  605.  
  606.     Move(PIconImage(lpIconImage).icHeader,
  607.          PIconImage(PIndex).icHeader,
  608.          sizeof(TIconImage));
  609.  
  610.     Move(PIconImage(PIndex).icColors,
  611.                IconColors,
  612.                16 * sizeof(TRGBQuad));
  613.  
  614.     SetupUndoBuff;
  615.   finally
  616.   end;
  617. end;
  618.  
  619. function TMainForm.Read16BitIcons(P : pchar) : boolean;
  620. var
  621.   N : integer;
  622.   NewIconName : string;
  623.   IH : HIcon;
  624. begin
  625.   Result:= false;
  626.   N:= 0;
  627.   IH:= ExtractIcon(hInstance, P, N);
  628.   while IH <> 0 do
  629.   begin
  630.     with TIcon.Create do
  631.     try
  632.       Handle:= IH;
  633.       SaveToFile(TempIconFile);
  634.     finally
  635.       Free;
  636.     end;
  637.  
  638.     inc(NewIconCnt);
  639.     NewIconName:= 'Icon' + IntToStr(MainForm.NewIconCnt) + '.ico';
  640.     if not ReadIconFromFile(TempIconFile,
  641.                             NewIconName,
  642.                             NewIconName,
  643.                             true) then
  644.       begin
  645.         DeleteFile(TempIconFile);
  646.         exit;
  647.       end;
  648.  
  649.     Result:= true;
  650.     DeleteFile(TempIconFile);
  651.     inc(N);
  652.     IH:= ExtractIcon(hInstance, P, N);
  653.   end;
  654. end;
  655.  
  656. procedure TMainForm.Import(FileName : TFileName);
  657. var
  658.   ModuleName : array[0..255] of char;
  659.   ModuleHandle : THandle;
  660. begin
  661.   StrPCopy(ModuleName, FileName);
  662.   ModuleHandle:= LoadLibraryEx(ModuleName,
  663.                                0,
  664.                                LOAD_LIBRARY_AS_DATAFILE);
  665.   if ModuleHandle = 0 then
  666.   begin
  667.     if not Read16BitIcons(ModuleName) then
  668.     begin
  669.       ShowMessage('Couldn''t load icon. ');
  670.       exit;
  671.     end;
  672.   end
  673.   else
  674.   begin
  675.     Imported:= false;
  676.  
  677.     if (not EnumResourceNames(
  678.            ModuleHandle,
  679.            RT_GROUP_ICON,
  680.            @EnumResName,
  681.            0)) or
  682.        (Imported = false) then
  683.       ShowMessage('Couldn''t find icon');
  684.  
  685.     FreeLibrary(ModuleHandle);
  686.   end;
  687. end;
  688.  
  689. procedure TMainForm.UpdateTool;
  690. begin
  691.   case DrawingTool of
  692.     Capture : CaptureSpeedButton.Down:= true;
  693.     Pencil : PencilSpeedButton.Down:= true;
  694.     Fill : FillSpeedButton.Down:= true;
  695.     Line : LineSpeedButton.Down:= true;
  696.     ClearRectangle : ClearRectangleSpeedButton.Down:= true;
  697.     FilledRectangle : FilledRectangleSpeedButton.Down:= true;
  698.     ClearEllipse : ClearEllipseSpeedButton.Down:= true;
  699.     FilledEllipse : FilledEllipseSpeedButton.Down:= true;
  700.   end;
  701. end;
  702.  
  703. procedure TMainForm.UpdateButtons;
  704. begin
  705.   Save.Enabled:= MDIChildCount > 0;
  706.   SaveSpeedButton.Enabled:= Save.Enabled;
  707.   SaveAs.Enabled:= Save.Enabled;
  708.   Close1.Enabled:= Save.Enabled;
  709.   CloseAll1.Enabled:= Save.Enabled;
  710. end;
  711.  
  712. procedure TMainForm.File1Click(Sender: TObject);
  713. begin
  714.   UpdateButtons;
  715. end;
  716.  
  717. procedure TMainForm.Edit1Click(Sender: TObject);
  718. begin
  719.   Undo.Enabled:= false;
  720.   Cut.Enabled:= false;
  721.   Copy.Enabled:= false;
  722.   Paste.Enabled:= false;
  723.   SelectAll.Enabled:= false;
  724.   TestIcon.Enabled:= false;
  725.  
  726.   if MDIChildCount = 0 then exit;
  727.  
  728.   with TIconForm(ActiveMDIChild) do
  729.   begin
  730.     Undo.Enabled:= UndoCount > 0;
  731.     Cut.Enabled:= Captured;
  732.   end;
  733.  
  734.   Copy.Enabled:= Cut.Enabled;
  735.   Paste.Enabled:= Clipboard.HasFormat(CF_DIB);
  736.   SelectAll.Enabled:= true;
  737.   TestIcon.Enabled:= true;
  738. end;
  739.  
  740. procedure TMainForm.UndoClick(Sender: TObject);
  741. begin
  742.   if MDIChildCount = 0 then exit;
  743.  
  744.   TIconForm(ActiveMDIChild).PreviousUndo;
  745. end;
  746.  
  747. procedure TMainForm.CutClick(Sender: TObject);
  748. begin
  749.   if MDIChildCount = 0 then exit;
  750.  
  751.   TIconForm(ActiveMDIChild).CutCaptured;
  752. end;
  753.  
  754. procedure TMainForm.CopyClick(Sender: TObject);
  755. begin
  756.   if MDIChildCount = 0 then exit;
  757.  
  758.   TIconForm(ActiveMDIChild).CopyCaptured;
  759. end;
  760.  
  761. procedure TMainForm.PasteClick(Sender: TObject);
  762. begin
  763.   if MDIChildCount = 0 then exit;
  764.  
  765.   TIconForm(ActiveMDIChild).Paste;
  766. end;
  767.  
  768. procedure TMainForm.SelectAllClick(Sender: TObject);
  769. begin
  770.   if MDIChildCount = 0 then exit;
  771.  
  772.   TIconForm(ActiveMDIChild).SelectAll;
  773. end;
  774.  
  775. procedure TMainForm.ShowPixelsClick(Sender: TObject);
  776. var
  777.   i : integer;
  778. begin
  779.   ShowPixels.Checked:= not ShowPixels.Checked;
  780.   for i:= 0 to MDIChildCount - 1 do
  781.     TIconForm(MDIChildren[i]).FormPaint(Sender);
  782. end;
  783.  
  784.  
  785. procedure TMainForm.TestIconClick(Sender: TObject);
  786. begin
  787.   if MDIChildCount = 0 then exit;
  788.  
  789.   TIconForm(ActiveMDIChild).TestIcon(Sender);
  790. end;
  791.  
  792. procedure TMainForm.FormResize(Sender: TObject);
  793. begin
  794.   if Width < DefaultWidth then
  795.     Width:= DefaultWidth;
  796.   if Height < DefaultHeight then
  797.     Height:= DefaultHeight;
  798. end;
  799.  
  800. procedure TMainForm.FormShow(Sender: TObject);
  801. var
  802.   FileName : TFileName;
  803.   i : integer;
  804. begin
  805.   for i:= 1 to ParamCount do
  806.   begin
  807.     FileName:= ParamStr(i);
  808.     if ExtractFileExt(FileName) <> 'ICO' then
  809.       Import(FileName)
  810.     else
  811.       ReadIconFromFile(FileName,
  812.                        FileName,
  813.                        ExtractFileName(FileName),
  814.                        false);
  815.   end;
  816.  
  817.   UpdateButtons;
  818. end;
  819.  
  820.  
  821. end.
  822.